Shareware Grab Bag/Shareware Grab Bag.iso/090/byte1286.arc/PERRY.ARC/DEMO-ONE.PAS

Pascal/Delphi Source File | 1980-01-01 | 7.0 KB | 345 lines

program DemoOne;
{one dimensional cellular automata }
var
  FilVar:    text;
  Line:      string[20];
  C:         string[1];

Ainit: array[0..4000] of byte;
      {4001 cells wide. Allows for}
Afield: array[0..4000] of byte;
      { expansion of COMPUTE FIELD }
  Bfield:    array[0..4000] of byte;
  Rule:        array[0..12] of byte;
  I,J,M,N,H,P,V,X,Nix:  integer;
  Ch:               char;

 Delta:    integer; { pixel spacing  1, or 2 }
 Dwidth:   Integer; { width of display field }
 Cwidth:   Integer; { width of compute field }

 Cstart:   integer; { COMPUTE FIELD. start with a }
 Cfinish:  integer; { width of 160 }

 Dstart:   integer; { display field }
 Dfinish:  integer;

 Vstart:   integer; { vertical display }
 Vfinish:  integer;

 Hstart:   integer; { horizontal display }
 Hfinish:  integer;

const  { typed constants }
       { these are essentially initialized variables }

  Widen:    Integer = 0;
  Bgnd:     Integer = 0;

  k:        integer = 4;   { number of states }
  RuleEnd:  integer = 9;   {  RuleEnd = 3 * (k - 1) }
  r:        integer = 1;   { Range; number of neighbors }



const
  Center = 2000;    {center of fields}
{ **********  start of procedures  **************** }

{------------------ 1 ------------------}

procedure DisplayMessage;
begin
  GoToXY(1,25);
  Write('DEMO-ONE: by Kenneth E. Perry.
  Press Ins');
end;

procedure DisplayStatusLine;
begin
  GoToXY(1,25);
  Write('                                     ');
  GoToXY(1,25);
  Write(Rule[0]);
  for I := 1 to 3 do
  begin
    write(' ');
    for J := 1 to 3 do
    begin
      write(Rule[3*(I-1)+J]);
    end;
  end;
{  Write('    ');
  Write(Bgnd);
  Write('    ');
  Write(Cwidth);   }
end;            {DisplayStatusLine}

{------------------ 2 ------------------}

procedure DisplayGenerations;
{ compute and display 190 generations
( or rows of cells ) }
begin
 for V := Vstart to Vfinish do
{ number of generations to display }
 begin
             { show display field }
      if Delta = 1 then
      begin
        for H := Hstart to Hfinish do
        begin
          I := H + Dstart;  { display one generation }
          plot(H,V,Afield[I]);
        end;
      end;

      if Delta = 2 then
      begin
        for H := Hstart to Hfinish do
        begin
          I := H + Dstart;
          plot(H+H,V+V,Afield[I]);
        end;
      end;

   { check for overflow of COMPUTE FIELD }

      if Widen = 1 then
      begin
        I := Cstart;
        J := Cfinish;
        if (Afield[I] <> Afield[I + 1]) or
           (Afield[J - 1] <> Afield[J]) then
        begin
          Cstart := Cstart - 1;
                    { this is to avoid end effects }
          Cfinish := Cfinish + 1;
          Cwidth := Cfinish - Cstart;
        end;
      end;

 {compute new row of cells and place in Bfield }

      for I := Cstart to Cfinish do
      begin
        N := Afield[I-1] + Afield[I] + Afield[I+1];
        Bfield[I] := Rule[N];
      end;

               {return Bfield to Afield}
      for I := Cstart to Cfinish do
      begin
        Afield[I] := Bfield[I];
      end;

    end; {for}
end;  { DisplayGenerations }

{------------------ 3 ------------------}

  procedure ReadRuleFromFile;
  begin {read rule from file 'DEMO-C.DOC' into 'Line'}
    Readln(FilVar,Line);

    J := 0;
    for I := 1 to 13 do
    begin
      C := Copy(Line,I,1);
      { copy rule, one digit at a time }
      if (C <> ' ') then     { skipping spaces }
      begin
        Val(C,M,Nix);
        { value of String[1] C placed in integer M }
        Rule[J] := M;
        { copy rule from 'Line' into 'Rule' }
        J := J + 1;
      end;
    end;
  end;      { ReadRuleFromFile }

{------------------ 6 ------------------}

procedure InitializeAinitToBackground;
begin
  for I := 0 to 4000 do
  begin
    Ainit[I] := Bgnd;
  end;
end;


{------------------ 7 ------------------}

procedure InitializeAinitRandom;
begin
{ random initialize of COMPUTE FIELD in Ainit}
    for I := Cstart to Cfinish do
    begin
      Ainit[I] := Random(k);
    end;
end;      { InitializeAinitRandom }

{------------------ 8 ------------------}

procedure MoveAinitToAfield;
begin
    for I := 0 to 4000 do
    begin
      Afield[I] := Ainit[I];
    end;
end;


{------------------ 11 -----------------}

procedure StartFinish;
begin
  Cstart := Center - (Cwidth div 2);
  Cfinish := Center + (Cwidth div 2) - 1;
  Dstart := Center - (Dwidth div 2);
  Dfinish := Center + (Dwidth div 2) - 1;
end;


{------------------ 13 -----------------}

procedure Field160X95;
begin
  GraphColorMode;
  Dwidth := 160;
  Cwidth := 160;

  StartFinish;

  Vstart := 0;
  Vfinish := 94;
  Hstart := 0;
  Hfinish := 159;
  Delta := 2;
  Delay(400);
  DisplayStatusLine;
end;

{------------------ 14 -----------------}

procedure Field320X190;
begin
  GraphColorMode;
  Dwidth := 320;
  Cwidth := 320;

  StartFinish;

  Vstart := 0;
  Vfinish := 189;
  Hstart := 0;
  Hfinish := 319;
  Delta := 1;
  Delay(400);
end;




{ **************   end  of procedures **************** }



{ ************** MAIN PROGRAM ********************** }


begin

Ch := ' ';
GraphColorMode;
Palette(0);
Randomize;
Field320X190;
DisplayMessage;


Assign(FilVar,'DEMO-1.DOC');
Reset(FilVar);

repeat
  if KeyPressed then
  begin                        {keypad symbols}
    Read(Kbd,Ch);
    if (Ch = #45) then               { - }
    begin
    end;


    if (Ch = #43) then               { + }
    begin                    { Continue Structure }
      DisplayStatusLine;
      DisplayGenerations;
    end;

        {escape sequences}

    if (Ch = #27) and KeyPressed then {one more char?}
    begin
      Read(Kbd,Ch);

      if (Ch = #82) then               { ins }
      begin               { new rule random initialize }
       Widen := 0;
       ReadRuleFromFile;
       DisplayStatusLine;
       InitializeAinitToBackground;
       InitializeAinitRandom;
       MoveAinitToAfield;
       DisplayGenerations;
      end;

      if (Ch = #83) then      { del }
      begin              { Same Rule Random Inititialize }
        Widen := 0;
        DisplayStatusLine;
        InitializeAinitRandom;
        MoveAinitToAfield;
        DisplayGenerations;
      end;


        {function keys}

      if (Ch = #59) then           { F1 }
      begin
      end;

      if (Ch = #60) then           { F2 }
      begin
      end;

      if (Ch = #61) then           { F3 }
      begin
      end;


      if (Ch = #66) then           { F8 }
      begin
      end;

      if (Ch = #67) then           { F9 }
      begin
      field160X95;
      end;

      if (Ch = #68) then           { F10 }
      begin
      Field320X190;
      end;

    end;  { if (Ch = #27 }
  end;  { if keypressed }
until Ch = #13;  { Return }  { end repeat }


end.